module decompMod

!------------------------------------------------------------------------------
!BOP
!
! !MODULE: decompMod
!
! !USES:
  use shr_kind_mod, only : r8 => shr_kind_r8
  use spmdMod     , only : masterproc, iam, npes, mpicom, comp_id
  use clm_varctl  , only : iulog
  use clm_mct_mod
  use abortutils  , only : endrun
!
! !PUBLIC TYPES:
  implicit none
  integer, public :: clump_pproc ! number of clumps per MPI process
!
! !PUBLIC MEMBER FUNCTIONS:
  public get_clump_bounds        ! beg and end gridcell, landunit, column,
                                 ! pft indices for clump
  public get_proc_clumps         ! number of clumps for this processor
  public get_proc_bounds_atm     ! beg and end gridcell for atm
  public get_proc_bounds         ! beg and end gridcell, landunit, column,
                                 ! pft indices for this processor
  public get_proc_total          ! total number of gridcells, landunits,
                                 ! columns and pfts for any processor
  public get_proc_global         ! total gridcells, landunits, columns, pfts
                                 ! across all processors
  public get_proc_global_atm     ! total atm cells on all pes
  public get_clmlevel_gsize      ! get global size associated with clmlevel
  public get_clmlevel_dsize      ! get global size associated with clmlevel
  public get_clmlevel_gsmap      ! get gsmap associated with clmlevel
!
! !DESCRIPTION:
! Module provides a descomposition into a clumped data structure which can
! be mapped back to atmosphere physics chunks.
!
! !REVISION HISTORY:
! 2002.09.11  Forrest Hoffman  Creation.
! 2005.11.01  T Craig  Rewrite
! 2006.06.06  T Craig  Reduce memory, cleanup
!
!
! !PRIVATE TYPES:
  private  ! (now mostly public for decompinitmod)

  integer,public :: nclumps     ! total number of clumps across all processors
  integer,public :: numg        ! total number of gridcells on all procs
  integer,public :: numl        ! total number of landunits on all procs
  integer,public :: numc        ! total number of columns on all procs
  integer,public :: nump        ! total number of pfts on all procs
  integer,public :: numa        ! total number of atm gridcells on all procs

  !---global information on each pe
  type processor_type
     integer :: nclumps          ! number of clumps for processor_type iam
     integer,pointer :: cid(:)   ! clump indices
     integer :: ncells           ! number of gridcells in proc
     integer :: nlunits          ! number of landunits in proc
     integer :: ncols            ! number of columns in proc
     integer :: npfts            ! number of pfts in proc
     integer :: begg, endg       ! beginning and ending gridcell index
     integer :: begl, endl       ! beginning and ending landunit index
     integer :: begc, endc       ! beginning and ending column index
     integer :: begp, endp       ! beginning and ending pft index
     integer :: abegg,aendg      ! beginning and ending atm gridcell index
  end type processor_type
  public processor_type
  type(processor_type),public :: procinfo

  !---global information on each pe
  type clump_type
     integer :: owner            ! process id owning clump
     integer :: ncells           ! number of gridcells in clump
     integer :: nlunits          ! number of landunits in clump
     integer :: ncols            ! number of columns in clump
     integer :: npfts            ! number of pfts in clump
     integer :: begg, endg       ! beginning and ending gridcell index
     integer :: begl, endl       ! beginning and ending landunit index
     integer :: begc, endc       ! beginning and ending column index
     integer :: begp, endp       ! beginning and ending pft index
  end type clump_type
  public clump_type
  type(clump_type),public, allocatable :: clumps(:)

  !---global information on each pe
  !--- i,j = 2d global
  !--- glo = 1d global sn ordered
  !--- gsn = 1d global sn ordered compressed
  !--- gdc = 1d global dc ordered compressed
  type decomp_type
     integer,pointer :: glo2gdc(:)    ! 1d glo to 1d gdc
     integer,pointer :: gdc2glo(:)    ! 1d gdc to 1d glo
  end type decomp_type
  public decomp_type
  type(decomp_type),public,target :: ldecomp
  type(decomp_type),public,target :: adecomp

  type(mct_gsMap)  ,public,target :: gsMap_atm_gdc2glo
  type(mct_gsMap)  ,public,target :: gsMap_lnd_gdc2glo

  type(mct_gsMap)  ,public,target :: gsMap_gce_gdc2glo
  type(mct_gsMap)  ,public,target :: gsMap_lun_gdc2glo
  type(mct_gsMap)  ,public,target :: gsMap_col_gdc2glo
  type(mct_gsMap)  ,public,target :: gsMap_pft_gdc2glo

!EOP
!------------------------------------------------------------------------------
! 
! 
!------------------------------------------------------------------------------

contains

!------------------------------------------------------------------------------
!BOP
!
! !IROUTINE: get_clump_bounds
!
! !INTERFACE:
   subroutine get_clump_bounds (n, begg, endg, begl, endl, begc, endc, &
                                begp, endp)
!
! !USES:
!
! !ARGUMENTS:
     implicit none
     integer, intent(in)  :: n           ! proc clump index
     integer, intent(out) :: begp, endp  ! clump beginning and ending
                                         ! pft indices
     integer, intent(out) :: begc, endc  ! clump beginning and ending
                                         ! column indices
     integer, intent(out) :: begl, endl  ! clump beginning and ending
                                         ! landunit indices
     integer, intent(out) :: begg, endg  ! clump beginning and ending
                                         ! gridcell indices
!
! !DESCRIPTION:
! Determine clump beginning and ending pft, column, landunit and
! gridcell indices.
!
! !REVISION HISTORY:
! 2003.09.12  Mariana Vertenstein  Creation.
!
!
! !LOCAL VARIABLES:
!EOP
     character(len=32), parameter :: subname = 'get_clump_bounds'  ! Subroutine name
     integer :: cid                                                ! clump id
#ifdef _OPENMP
     integer, external :: OMP_GET_MAX_THREADS
     integer, external :: OMP_GET_NUM_THREADS
#endif
!------------------------------------------------------------------------------
!
!    Make sure this IS being called from a threaded region
!
#ifdef _OPENMP
     if ( OMP_GET_NUM_THREADS() == 1 .and. OMP_GET_MAX_THREADS() > 1 )then
        call endrun( trim(subname)//' ERROR: Calling from inside a non-threaded region -- this results in bad performance' )
     end if
#endif

     cid  = procinfo%cid(n)
     begp = clumps(cid)%begp
     endp = clumps(cid)%endp
     begc = clumps(cid)%begc
     endc = clumps(cid)%endc
     begl = clumps(cid)%begl
     endl = clumps(cid)%endl
     begg = clumps(cid)%begg
     endg = clumps(cid)%endg

   end subroutine get_clump_bounds

!------------------------------------------------------------------------------
!BOP
!
! !IROUTINE: get_proc_bounds
!
! !INTERFACE:
   subroutine get_proc_bounds (begg, endg, begl, endl, begc, endc, &
                               begp, endp)
!
! !USES:
!
! !ARGUMENTS:
     implicit none
     integer, optional, intent(out) :: begp, endp  ! proc beginning and ending
                                                   ! pft indices
     integer, optional, intent(out) :: begc, endc  ! proc beginning and ending
                                                   ! column indices
     integer, optional, intent(out) :: begl, endl  ! proc beginning and ending
                                                   ! landunit indices
     integer, optional, intent(out) :: begg, endg  ! proc beginning and ending
                                                   ! gridcell indices
! !DESCRIPTION:
! Retrieve gridcell, landunit, column, and pft bounds for process.
!
! !REVISION HISTORY:
! 2003.09.12  Mariana Vertenstein  Creation.
!
! !LOCAL VARIABLES:
!EOP
     character(len=32), parameter :: subname = 'get_proc_bounds'  ! Subroutine name
#ifdef _OPENMP
     integer, external :: OMP_GET_NUM_THREADS
#endif
!------------------------------------------------------------------------------
!
!    Make sure this is NOT being called from a threaded region
!
#ifdef _OPENMP
     if ( OMP_GET_NUM_THREADS() > 1 )then
        call endrun( trim(subname)//' ERROR: Calling from inside a threaded region -- this is illegal' )
     end if
#endif

     if (present(begp)) then
        begp = procinfo%begp
     endif
     if (present(endp)) then
        endp = procinfo%endp
     endif
     if (present(begc)) then
        begc = procinfo%begc
     endif
     if (present(endc)) then
        endc = procinfo%endc
     endif
     if (present(begl)) then
        begl = procinfo%begl
     endif
     if (present(endl)) then
        endl = procinfo%endl
     endif
     if (present(begg)) then
        begg = procinfo%begg
     endif
     if (present(endg)) then
        endg = procinfo%endg
     endif

   end subroutine get_proc_bounds

!------------------------------------------------------------------------------
!BOP
!
! !IROUTINE: get_proc_bounds_atm
!
! !INTERFACE:
   subroutine get_proc_bounds_atm (begg, endg)
!
! !USES:
!
! !ARGUMENTS:
     implicit none
     integer, intent(out) :: begg, endg  ! proc beginning and ending
                                         ! gridcell indices for atm grid
! !DESCRIPTION:
! Retrieve gridcell begg, endg for atm decomp
!
! !REVISION HISTORY:
! 2005.12.15  T Craig Added
!
!------------------------------------------------------------------------------
! !LOCAL VARIABLES:
!EOP
     character(len=32), parameter :: subname = 'get_proc_bounds_atm'  ! Subroutine name
#ifdef _OPENMP
     integer, external :: OMP_GET_NUM_THREADS
#endif
!------------------------------------------------------------------------------
!
!    Make sure this is NOT being called from a threaded region
!
#ifdef _OPENMP
     if ( OMP_GET_NUM_THREADS() > 1 )then
        call endrun( trim(subname)//' ERROR: Calling from inside a threaded region -- this is illegal' )
     end if
#endif

   begg = procinfo%abegg
   endg = procinfo%aendg

   end subroutine get_proc_bounds_atm

!------------------------------------------------------------------------------
!BOP
!
! !IROUTINE: get_proc_total
!
! !INTERFACE:
   subroutine get_proc_total(pid, ncells, nlunits, ncols, npfts)
!
! !DESCRIPTION:
! Count up gridcells, landunits, columns, and pfts on process.
!
! !USES:
!
! !ARGUMENTS:
     implicit none
     integer, intent(in)  :: pid     ! proc id
     integer, intent(out) :: ncells  ! total number of gridcells
                                     ! on the processor
     integer, intent(out) :: nlunits ! total number of landunits
                                     ! on the processor
     integer, intent(out) :: ncols   ! total number of columns
                                     ! on the processor
     integer, intent(out) :: npfts   ! total number of pfts
                                     ! on the processor
!
! !REVISION HISTORY:
! 2003.09.12  Mariana Vertenstein  Creation.
!
!
! !LOCAL VARIABLES:
!EOP
   integer :: cid       ! clump index
!------------------------------------------------------------------------------

     npfts   = 0
     nlunits = 0
     ncols   = 0
     ncells  = 0
     do cid = 1,nclumps
        if (clumps(cid)%owner == pid) then
           ncells  = ncells  + clumps(cid)%ncells
           nlunits = nlunits + clumps(cid)%nlunits
           ncols   = ncols   + clumps(cid)%ncols
           npfts   = npfts   + clumps(cid)%npfts
        end if
     end do

   end subroutine get_proc_total

!------------------------------------------------------------------------------
!BOP
!
! !IROUTINE: get_proc_global
!
! !INTERFACE:
   subroutine get_proc_global(ng, nl, nc, np)
!
! !DESCRIPTION:
! Return number of gridcells, landunits, columns, and pfts across all
! processes.
!
! !USES:
!
! !ARGUMENTS:
     implicit none
     integer, intent(out) :: ng  ! total number of gridcells
                                 ! across all processors
     integer, intent(out) :: nl  ! total number of landunits
                                 ! across all processors
     integer, intent(out) :: nc  ! total number of columns
                                 ! across all processors
     integer, intent(out) :: np  ! total number of pfts
                                 ! across all processors
! !REVISION HISTORY:
! 2003.09.12  Mariana Vertenstein  Creation.
!
!EOP
!------------------------------------------------------------------------------

     np = nump
     nc = numc
     nl = numl
     ng = numg

   end subroutine get_proc_global

!------------------------------------------------------------------------------
!BOP
!
! !IROUTINE: get_proc_global_atm
!
! !INTERFACE:
   subroutine get_proc_global_atm(na)
!
! !DESCRIPTION:
! Return number of gridcells, landunits, columns, and pfts across all
! processes.
!
! !USES:
!
! !ARGUMENTS:
     implicit none
     integer, intent(out) :: na  ! total number of atm gridcells
                                 ! across all processors
! !REVISION HISTORY:
! 2003.09.12  Mariana Vertenstein  Creation.
!
!EOP
!------------------------------------------------------------------------------

     na = numa

   end subroutine get_proc_global_atm


!------------------------------------------------------------------------------
!BOP
!
! !IROUTINE: get_proc_clumps
!
! !INTERFACE:
   integer function get_proc_clumps()
!
! !DESCRIPTION:
! Return the number of clumps.
!
! !USES:
!
! !ARGUMENTS:
     implicit none
!
! !RETURN VALUE:
!    integer :: get_proc_clumps
!
! !REVISION HISTORY:
! 2003.09.12  Mariana Vertenstein  Creation.
!
!EOP
!------------------------------------------------------------------------------

     get_proc_clumps = procinfo%nclumps

   end function get_proc_clumps

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: get_clmlevel_gsize
!
! !INTERFACE:
  integer function get_clmlevel_gsize (clmlevel)
!
! !DESCRIPTION:
! Determine 1d size from clmlevel
!
! !USES:
  use clmtype  , only : gratm, grlnd, nameg, namel, namec, namep, allrof
  use domainMod, only : adomain,ldomain
#ifdef RTM
  use clm_varpar,only : rtmlon,rtmlat
#endif
!
! !ARGUMENTS:
    implicit none
    character(len=*), intent(in) :: clmlevel    !type of clm 1d array
!
! !REVISION HISTORY:
!
!
! !LOCAL VARIABLES:
!EOP

!-----------------------------------------------------------------------
    ! Determine necessary indices

    select case (clmlevel)
    case(gratm)
       get_clmlevel_gsize = adomain%ns
    case(grlnd)
       get_clmlevel_gsize = ldomain%ns
    case(nameg)
       get_clmlevel_gsize = numg
    case(namel)
       get_clmlevel_gsize = numl
    case(namec)
       get_clmlevel_gsize = numc
    case(namep)
       get_clmlevel_gsize = nump
#ifdef RTM
    case(allrof)
       get_clmlevel_gsize = rtmlon*rtmlat
#endif
    case default
       write(iulog,*) 'get_clmlevel_gsize does not match clmlevel type: ', trim(clmlevel)
       call endrun()
    end select

  end function get_clmlevel_gsize
!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: get_clmlevel_dsize
!
! !INTERFACE:
  subroutine get_clmlevel_dsize (clmlevel,dims,s1,s2,s3,s4)
!
! !DESCRIPTION:
! Determine number of dims and size of dims from clmlevel
!
! !USES:
  use clmtype  , only : gratm, grlnd, nameg, namel, namec, namep, allrof
  use domainMod, only : adomain,ldomain
#ifdef RTM
  use clm_varpar,only : rtmlon,rtmlat
#endif
!
! !ARGUMENTS:
    implicit none
    character(len=*), intent(in ) :: clmlevel    !type of clm 1d array
    integer,          intent(out) :: dims        ! number of dimensions
    integer,optional, intent(out) :: s1          ! size of dim1
    integer,optional, intent(out) :: s2          ! size of dim2
    integer,optional, intent(out) :: s3          ! size of dim3
    integer,optional, intent(out) :: s4          ! size of dim4

!
! !REVISION HISTORY:
!
!
! !LOCAL VARIABLES:
!EOP
    integer :: ls(4)

!-----------------------------------------------------------------------
    ! Determine necessary indices

    dims = 1
    ls = 1

    select case (clmlevel)
    case(gratm)
       dims = 2
       ls(1) = adomain%ni
       ls(2) = adomain%nj
    case(grlnd)
       dims = 2
       ls(1) = ldomain%ni
       ls(2) = ldomain%nj
    case(nameg)
       ls(1) = numg
    case(namel)
       ls(1) = numl
    case(namec)
       ls(1) = numc
    case(namep)
       ls(1) = nump
#ifdef RTM
    case(allrof)
       dims = 2
       ls(1) = rtmlon
       ls(2) = rtmlat
#endif
    case default
       write(iulog,*) 'get_clmlevel_dsize does not match clmlevel type: ', trim(clmlevel)
       call endrun()
    end select

    if (present(s1)) then
       s1 = ls(1)
    endif
    if (present(s2)) then
       s2 = ls(2)
    endif
    if (present(s3)) then
       s3 = ls(3)
    endif
    if (present(s4)) then
       s4 = ls(4)
    endif

  end subroutine get_clmlevel_dsize
!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: get_clmlevel_gsmap
!
! !INTERFACE:
  subroutine get_clmlevel_gsmap (clmlevel, gsmap)
!
! !DESCRIPTION:
! Compute arguments for gatherv, scatterv for vectors
!
! !USES:
    use clmtype  , only : gratm, grlnd, nameg, namel, namec, namep, allrof

#if (defined RTM)
    use RunoffMod, only : gsMap_rtm_gdc2glo
#endif
!
! !ARGUMENTS:
    implicit none
    character(len=*), intent(in) :: clmlevel     ! type of input data
    type(mct_gsmap), pointer :: gsmap

! !REVISION HISTORY:
! Author: Mariana Vertenstein
!
!
! !LOCAL VARIABLES:
!EOP

!----------------------------------------------------------------------

    select case (clmlevel)
    case(gratm)
       gsmap => gsmap_atm_gdc2glo

    case(grlnd)
       gsmap => gsmap_lnd_gdc2glo

    case(nameg)
       gsmap => gsmap_gce_gdc2glo

    case(namel)
       gsmap => gsmap_lun_gdc2glo

    case(namec)
       gsmap => gsmap_col_gdc2glo

    case(namep)
       gsmap => gsmap_pft_gdc2glo

#if (defined RTM)
    case(allrof)
       gsmap => gsmap_rtm_gdc2glo
#endif

    case default

       write(iulog,*) 'get_clmlevel_gsmap: Invalid expansion character: ',trim(clmlevel)
       call endrun

    end select

  end subroutine get_clmlevel_gsmap

!------------------------------------------------------------------------------

end module decompMod
